Homework #3

1. 2.5절 배열에서 다룬 확장 예제 “RGB값을 무작위로 샘플링 후 매개변수로 노이즈 가중치 조절해 보기” 명령 스크립트 중 다음아래에 해당하는 구문의 반복 명령을 최소화한 스크립트 작성 후 해당 스크립트가 정상적으로 작동하는지 그림 출력을 통해 확인하시오. 단, 그림은 2.5절 예제와 동일한 그림을 사용(Hint: *apply() 계열 함수, 코드블록({}), return(), unlist(), array() 함수 사용)

require(tidyverse)
## Loading required package: tidyverse
## ─ Attaching packages ─────────────────────────────────── tidyverse 1.3.0 ─
## <U+2713> ggplot2 3.2.1     <U+2713> purrr   0.3.3
## <U+2713> tibble  2.1.3     <U+2713> dplyr   0.8.3
## <U+2713> tidyr   1.0.0     <U+2713> stringr 1.4.0
## <U+2713> readr   1.3.1     <U+2713> forcats 0.4.0
## ─ Conflicts ──────────────────────────────────── tidyverse_conflicts() ─
## x dplyr::filter() masks stats::filter()
## x dplyr::lag()    masks stats::lag()
require(jpeg)
## Loading required package: jpeg
require(cowplot)
## Loading required package: cowplot
## 
## ********************************************************
## Note: As of version 1.0.0, cowplot does not change the
##   default ggplot2 theme anymore. To recover the previous
##   behavior, execute:
##   theme_set(theme_cowplot())
## ********************************************************
myurl <- paste0("https://img.livescore.co.kr/data/editor/1906/", 
                "ba517de8162d92f4ea0e9de0ec98ba02.jpg")
z <- tempfile()
download.file(myurl,z,mode="wb")

pic <- readJPEG(z)
dim_pic <- dim(pic)
t <- 0.2; nl <- length(300:460); pl <- length(440:520)

# 다음 아래(문제 1에 해당)
# yr <- pic[300:460, 440:520, 1]
# yg <- pic[300:460, 440:520, 2]
# yb <- pic[300:460, 440:520, 3]
# 
# wr <- t * yr + (1 - t)*matrix(runif(length(yr)), nrow = nl, ncol = pl)
# wg <- t * yg + (1 - t)*matrix(runif(length(yg)), nrow = nl, ncol = pl)
# wb <- t * yb + (1 - t)*matrix(runif(length(yb)), nrow = nl, ncol = pl)
# 
# 
# pic[300:460, 440:520, 1] <- wr
# pic[300:460, 440:520, 2] <- wg
# pic[300:460, 440:520, 3] <- wb

Answer

tmp <- lapply(1:3, function(i) {
  # browser()
  x <- pic[, , i]
  wx <- x[300:460, 440:520]
  wx <- t * wx + (1 - t)*matrix(runif(length(wx)), nrow = nl, ncol = pl)
  x[300:460, 440:520] <- wx
  return(x)
})

res <- array(unlist(tmp), dim = dim_pic)
ggdraw() + 
  draw_image(res)

res <- pic
y <- unlist(lapply(pic[300:460, 440:520, ], function(x) return(x)))
u <- t * y + (1 - t)*runif(length(y))
res[300:460, 440:520, ] <- array(u, dim = c(nl, pl, 3))

ggdraw() + 
  draw_image(res)

res <- pic
z <- c(pic[300:460, 440:520, ])
w <- t * z + (1 - t)*runif(length(z))
res[300:460, 440:520, ] <- array(w, dim = c(nl, pl, 3))

ggdraw() + 
  draw_image(res)


2. R에 기본으로 내장된 mtcars 데이터셋은 다음과 같이 11개의 변수로 구성되어 있다.

  1. mtcars의 데이터 구조를 파악하고 자료의 전반적인 형태에 대해 기술 하시오.

Answer

df <- mtcars
head(df); dim(df); str(df); summary(df)
## [1] 32 11
## 'data.frame':    32 obs. of  11 variables:
##  $ mpg : num  21 21 22.8 21.4 18.7 18.1 14.3 24.4 22.8 19.2 ...
##  $ cyl : num  6 6 4 6 8 6 8 4 4 6 ...
##  $ disp: num  160 160 108 258 360 ...
##  $ hp  : num  110 110 93 110 175 105 245 62 95 123 ...
##  $ drat: num  3.9 3.9 3.85 3.08 3.15 2.76 3.21 3.69 3.92 3.92 ...
##  $ wt  : num  2.62 2.88 2.32 3.21 3.44 ...
##  $ qsec: num  16.5 17 18.6 19.4 17 ...
##  $ vs  : num  0 0 1 1 0 1 0 1 1 1 ...
##  $ am  : num  1 1 1 0 0 0 0 0 0 0 ...
##  $ gear: num  4 4 4 3 3 3 3 4 4 4 ...
##  $ carb: num  4 4 1 1 2 1 4 2 2 4 ...
##       mpg             cyl             disp             hp       
##  Min.   :10.40   Min.   :4.000   Min.   : 71.1   Min.   : 52.0  
##  1st Qu.:15.43   1st Qu.:4.000   1st Qu.:120.8   1st Qu.: 96.5  
##  Median :19.20   Median :6.000   Median :196.3   Median :123.0  
##  Mean   :20.09   Mean   :6.188   Mean   :230.7   Mean   :146.7  
##  3rd Qu.:22.80   3rd Qu.:8.000   3rd Qu.:326.0   3rd Qu.:180.0  
##  Max.   :33.90   Max.   :8.000   Max.   :472.0   Max.   :335.0  
##       drat             wt             qsec             vs        
##  Min.   :2.760   Min.   :1.513   Min.   :14.50   Min.   :0.0000  
##  1st Qu.:3.080   1st Qu.:2.581   1st Qu.:16.89   1st Qu.:0.0000  
##  Median :3.695   Median :3.325   Median :17.71   Median :0.0000  
##  Mean   :3.597   Mean   :3.217   Mean   :17.85   Mean   :0.4375  
##  3rd Qu.:3.920   3rd Qu.:3.610   3rd Qu.:18.90   3rd Qu.:1.0000  
##  Max.   :4.930   Max.   :5.424   Max.   :22.90   Max.   :1.0000  
##        am              gear            carb      
##  Min.   :0.0000   Min.   :3.000   Min.   :1.000  
##  1st Qu.:0.0000   1st Qu.:3.000   1st Qu.:2.000  
##  Median :0.0000   Median :4.000   Median :2.000  
##  Mean   :0.4062   Mean   :3.688   Mean   :2.812  
##  3rd Qu.:1.0000   3rd Qu.:4.000   3rd Qu.:4.000  
##  Max.   :1.0000   Max.   :5.000   Max.   :8.000


  1. 위 코드북을 참고하여 엔진과 변속기어에 해당하는 변수를 factor로 변환 후 해당 데이터 프레임을 df 객체에 저장 하시오.

Answer

df <- within(df, {
  vs <- factor(vs, levels = 0:1, 
               labels = c("V-shaped", "straight"))
  am <- factor(am, levels = 0:1, 
               labels = c("automatic", "manual"))
})
summary(df)
##       mpg             cyl             disp             hp       
##  Min.   :10.40   Min.   :4.000   Min.   : 71.1   Min.   : 52.0  
##  1st Qu.:15.43   1st Qu.:4.000   1st Qu.:120.8   1st Qu.: 96.5  
##  Median :19.20   Median :6.000   Median :196.3   Median :123.0  
##  Mean   :20.09   Mean   :6.188   Mean   :230.7   Mean   :146.7  
##  3rd Qu.:22.80   3rd Qu.:8.000   3rd Qu.:326.0   3rd Qu.:180.0  
##  Max.   :33.90   Max.   :8.000   Max.   :472.0   Max.   :335.0  
##       drat             wt             qsec              vs             am    
##  Min.   :2.760   Min.   :1.513   Min.   :14.50   V-shaped:18   automatic:19  
##  1st Qu.:3.080   1st Qu.:2.581   1st Qu.:16.89   straight:14   manual   :13  
##  Median :3.695   Median :3.325   Median :17.71                               
##  Mean   :3.597   Mean   :3.217   Mean   :17.85                               
##  3rd Qu.:3.920   3rd Qu.:3.610   3rd Qu.:18.90                               
##  Max.   :4.930   Max.   :5.424   Max.   :22.90                               
##       gear            carb      
##  Min.   :3.000   Min.   :1.000  
##  1st Qu.:3.000   1st Qu.:2.000  
##  Median :4.000   Median :2.000  
##  Mean   :3.688   Mean   :2.812  
##  3rd Qu.:4.000   3rd Qu.:4.000  
##  Max.   :5.000   Max.   :8.000


  1. df 데이터셋에서 변속기어 (am)에 따른 mpg, disp, hp, drat, wt, qsec에 대한 평균과 표준편차의 결과를 각각 mtcar_mean, mtcar_std 객제에 저장 후 확인하시오(Hint: mean(), sd() 함수 사용). 단 각 결과는 테이블 형태로 반환되어야 함(한 객체에 모든 변수의 평균 또는 표준편차가 저장. 결과가 테이블 객체의 반환을 의미하는 것은 아님).
aggregate(cbind(mpg, disp, hp, drat, wt, qsec) ~ am, 
          data = df, 
          mean)
aggregate(cbind(mpg, disp, hp, drat, wt, qsec) ~ am, 
          data = df, 
          sd)


  1. df 데이터셋을 엔진형태(vs) 별로 나눈 후, 연비를 종속변수(\(y\))로 놓고 무게(wt)를 독립변수로 사용한 일변량 회귀식을 반환 하시오.
dfl <- split(df, df$vs)
sapply(dfl, function(x) coef(lm(mpg ~ wt, data = x)))
##             V-shaped  straight
## (Intercept) 29.53144 41.298140
## wt          -3.50131 -6.411017


3. 1912년 4월 14일 타이타닉호 침몰 사고의 생존자 정보를 담고 있는 titanic 데이터셋은 통계학적으로 범주형 데이터 분석의 예시로서 널리 사용되고 있으며, 기계학습 및 데이터 과학 커뮤니티인 Kaggle에서도 기계학습 알고리즘 경연을 위한 힉습자료로 활용되고 있다. 해당 데이터는 http://biostat.mc.vanderbilt.edu/wiki/pub/Main/DataSets/titanic3.csv 에서 다운로드가 가능하다. 타이타닉 데이터의 주요 변수에 대한 설명은 아래와 같다.

  1. 위 코드북의 내용을 codebook_tit 이란 데이터 프레임 객체에 저장 후 출력하시오.
`변수명` <- c("pclass", "survived", "name", "sex", "age", "sibsp", 
              "parch", "ticket", "fare", "cabin", "embarked")
`변수설명(영문)` <- c("Passenger Class (1=1st; 2=2nd; 3=3rd)", "Survival (0=No; 1=Yes)", 
                      "Passenger name", "Sex", "Age", "# of siblings/spouses abroad", 
                      "# of parents/children abroad", "Ticket number", "Passenger fare", 
                      "Cabin", "Port of embarkation (C=Cherbourg; Q=Queenstown; S=Southhampton")
`변수설명(국문)` <- c("선실 등급", "생존여부", "탐승객 성명", "성별", "나이", 
                      "동승한 형제/배우자 수", "동승한 부모/자녀 수", "티켓번호", "티켓요금", 
                      "선실번호", "탑승 장소")
desc_titanic <- data.frame(`변수명`, 
                           `변수설명(영문)`, 
                           `변수설명(국문)`, 
                           check.names = FALSE, 
                           stringsAsFactors = FALSE)
desc_titanic


  1. 위 URL 주소로부터 타이타닉 데이터 파일을 읽은 후 titanic 객체에 저장한 뒤 위 코드북(강의노트 문제 3에서 제시된 테이블)에서 제시한 변수(변수명)만 추출한 다음 df_titanic이란 객체에 저장한 결과에 대해 개괄적 형태 및 데이터 특성에 대해 기술하시오.
titanic <- read.csv("http://biostat.mc.vanderbilt.edu/wiki/pub/Main/DataSets/titanic3.csv")
df_titanic <- titanic[, `변수명`]
head(df_titanic); dim(df_titanic); str(df_titanic); summary(df_titanic)
## [1] 1309   11
## 'data.frame':    1309 obs. of  11 variables:
##  $ pclass  : int  1 1 1 1 1 1 1 1 1 1 ...
##  $ survived: int  1 1 0 0 0 1 1 0 1 0 ...
##  $ name    : Factor w/ 1307 levels "Abbing, Mr. Anthony",..: 22 24 25 26 27 31 46 47 51 55 ...
##  $ sex     : Factor w/ 2 levels "female","male": 1 2 1 2 1 2 1 2 1 2 ...
##  $ age     : num  29 0.92 2 30 25 48 63 39 53 71 ...
##  $ sibsp   : int  0 1 1 1 1 0 1 0 2 0 ...
##  $ parch   : int  0 2 2 2 2 0 0 0 0 0 ...
##  $ ticket  : Factor w/ 929 levels "110152","110413",..: 188 50 50 50 50 125 93 16 77 826 ...
##  $ fare    : num  211 152 152 152 152 ...
##  $ cabin   : Factor w/ 187 levels "","A10","A11",..: 45 81 81 81 81 151 147 17 63 1 ...
##  $ embarked: Factor w/ 4 levels "","C","Q","S": 4 4 4 4 4 4 4 4 4 2 ...
##      pclass         survived                                   name     
##  Min.   :1.000   Min.   :0.000   Connolly, Miss. Kate            :   2  
##  1st Qu.:2.000   1st Qu.:0.000   Kelly, Mr. James                :   2  
##  Median :3.000   Median :0.000   Abbing, Mr. Anthony             :   1  
##  Mean   :2.295   Mean   :0.382   Abbott, Master. Eugene Joseph   :   1  
##  3rd Qu.:3.000   3rd Qu.:1.000   Abbott, Mr. Rossmore Edward     :   1  
##  Max.   :3.000   Max.   :1.000   Abbott, Mrs. Stanton (Rosa Hunt):   1  
##                                  (Other)                         :1301  
##      sex           age            sibsp            parch            ticket    
##  female:466   Min.   : 0.17   Min.   :0.0000   Min.   :0.000   CA. 2343:  11  
##  male  :843   1st Qu.:21.00   1st Qu.:0.0000   1st Qu.:0.000   1601    :   8  
##               Median :28.00   Median :0.0000   Median :0.000   CA 2144 :   8  
##               Mean   :29.88   Mean   :0.4989   Mean   :0.385   3101295 :   7  
##               3rd Qu.:39.00   3rd Qu.:1.0000   3rd Qu.:0.000   347077  :   7  
##               Max.   :80.00   Max.   :8.0000   Max.   :9.000   347082  :   7  
##               NA's   :263                                      (Other) :1261  
##       fare                     cabin      embarked
##  Min.   :  0.000                  :1014    :  2   
##  1st Qu.:  7.896   C23 C25 C27    :   6   C:270   
##  Median : 14.454   B57 B59 B63 B66:   5   Q:123   
##  Mean   : 33.295   G6             :   5   S:914   
##  3rd Qu.: 31.275   B96 B98        :   4           
##  Max.   :512.329   C22 C26        :   4           
##  NA's   :1         (Other)        : 271


  1. age 변수에 포함된 결측값을 age의 전체 평균값으로 대체 하시오.
sum(is.na(df_titanic))
## [1] 264
df_titanic$age[is.na(df_titanic$age)] <- mean(df_titanic$age, na.rm = TRUE)
summary(df_titanic)
##      pclass         survived                                   name     
##  Min.   :1.000   Min.   :0.000   Connolly, Miss. Kate            :   2  
##  1st Qu.:2.000   1st Qu.:0.000   Kelly, Mr. James                :   2  
##  Median :3.000   Median :0.000   Abbing, Mr. Anthony             :   1  
##  Mean   :2.295   Mean   :0.382   Abbott, Master. Eugene Joseph   :   1  
##  3rd Qu.:3.000   3rd Qu.:1.000   Abbott, Mr. Rossmore Edward     :   1  
##  Max.   :3.000   Max.   :1.000   Abbott, Mrs. Stanton (Rosa Hunt):   1  
##                                  (Other)                         :1301  
##      sex           age            sibsp            parch            ticket    
##  female:466   Min.   : 0.17   Min.   :0.0000   Min.   :0.000   CA. 2343:  11  
##  male  :843   1st Qu.:22.00   1st Qu.:0.0000   1st Qu.:0.000   1601    :   8  
##               Median :29.88   Median :0.0000   Median :0.000   CA 2144 :   8  
##               Mean   :29.88   Mean   :0.4989   Mean   :0.385   3101295 :   7  
##               3rd Qu.:35.00   3rd Qu.:1.0000   3rd Qu.:0.000   347077  :   7  
##               Max.   :80.00   Max.   :8.0000   Max.   :9.000   347082  :   7  
##                                                                (Other) :1261  
##       fare                     cabin      embarked
##  Min.   :  0.000                  :1014    :  2   
##  1st Qu.:  7.896   C23 C25 C27    :   6   C:270   
##  Median : 14.454   B57 B59 B63 B66:   5   Q:123   
##  Mean   : 33.295   G6             :   5   S:914   
##  3rd Qu.: 31.275   B96 B98        :   4           
##  Max.   :512.329   C22 C26        :   4           
##  NA's   :1         (Other)        : 271
# df_titanic$age


  1. df_titanic에서 age 를 다음과 같이 그룹화 후 age_group 변수(factor)를 생성 하시오.
# 0 살 이상 15살 미만: Children
# 15살 이상: Adult

df_titanic$age_group <- factor(ifelse(df_titanic$age < 15, "Children", "Adult"), 
                               levels = c("Children", "Adult"))


  1. 선실 등급에 따른 남녀 별 그리고 연령 집단 별 생존 빈도 및 비율에 대해 각각 테이블로 나타내시오.
# 1. 등급 * 성별 * 생존여부
# 2. 등급 * 연령집단 * 생존여부

tab1 <- with(df_titanic, table(sex, survived, pclass))
ptab1 <- prop.table(tab1, margin = c(1,3))

tab2 <- with(df_titanic, table(age_group, survived, pclass))
ptab2 <- prop.table(tab2, margin = c(1,3))


4. 아래와 같은 데이터셋이 주어졌을 때


  1. Dataset #1에 해당하는 데이터를 authors, dataset #2에 해당하는 데이터를 books 에 저장한 객체를 생성 하시오(단, 데이터 프레임을 구성하는 모든 변수는 문자열 변수로 저장).
authors <- data.frame(surname = c("Tukey", "Venables", "Tierney", "Ripley", "McNeil"), 
    nationality = c("US", "Australia", "US", "UK", "Australia"), stringsAsFactors = FALSE)
books <- data.frame(name = c("Tukey", "Venables", "Tierney", "Ripley", "Ripley", 
    "McNeil", "R Core"), title = c("Exploratory Data Analysis", "Modern Applied Statistics ...", 
    "LISP-STAT", "Spatial Statistics", "Stochastic Simulation", "Interactive Data Analysis", 
    "An Introduction to R"), stringsAsFactors = FALSE)
authors
books


  1. 두 데이터 셋을 authors 기준으로 병합한 데이터셋을 생성하시오.
merge(authors, books, by.x = "surname", by.y = "name")


  1. 두 데이터 셋의 모든 값들을 포함한 결함 데이터 셋을 생성 하시오.
merge(authors, books, by.x = "surname", by.y = "name", all = TRUE)